home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
PRUS101
/
FCRT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-12-19
|
39KB
|
1,132 lines
UNIT FCRT; { FIDO unit to enhance and replace TP's CRT unit, screen handling }
(***************************************************************************
RELEASE 1.14 - as first contained in the file PRUS101.LZH
by Orazio Czerwenka, 2:2450/540.55, GERMANY
--------------------------------------------
organized for Fido's PASCAL related echoes
--------------------------------------------
05/14/1994 to 12/15/1994 by Orazio Czerwenka, 2:2450/540.55, GERMANY
12/15/1994 to --/--/---- by Paul Schubert, 2:244/1181.18, GERMANY
As far as third party copyrights are not violated this
source code is hereby placed to the public domain. Use
it whatever way you want, but use AT YOUR OWN RISK.
In case you should modify the source rather send your
modifications to the unit's current organizer (see above for
NM address) than to spread it on your own. This will help to
keep the unit updated and grant a certain standard to all
other users as well.
The unit is currently still under work. So it might greatly
benefit of your participation.
Those who contributed to the following piece of source,
listed in alphabethical order:
================================================================
Ralph Brown(interrupt listings), Orazio Czerwenka, Jens
Larsson, Max Maischein, Sean Palmer, Christian Proehl, Paul
Schubert(FCONDRV.INC), SWAG Support Team (hardware indepen-
dend delay) ...
================================================================
YOUR NAME WILL APPEAR HERE IF YOU CONTRIBUTE USEFUL SOURCE.
Special thanx to Paul Schubert who significantly enhanced
this unit by contributing an additional include file FCONDRV
to partially clone and improve CRT's screen related standard
routines.
Credits in your own programs are as welcome as unnecessary.
***************************************************************************)
{$I FDEFINE.DEF} { Use the general include file for conditional defines and
common compiler directives ... }
{ ... and set the unit's specific defines aftwerwards. }
{$A+} { A+ will slightly speed up some of the more important
source }
{$F+,R-,S-}
Interface
USES
dos;
CONST
{ Don't yet rely on these colour constants, they have been implemented
only for usage by another unit currently under work but might well
cease to be included in future releases }
BLACK = 0; BLUE = 16; GREEN = 32; CYAN = 48;
RED = 64; MAGENTA = 80; BROWN = 96; LIGHTGRAY = 112;
PageFlipping : Boolean = TRUE;
TEXTATTR : BYTE = 7;
WINDMIN : WORD = 0;
WINDMAX : WORD = 6223;
DIRECTVIDEO : BOOLEAN = TRUE;
TYPE
NameStr = STRING[8];
CursorShape = RECORD top, bottom : byte; END;
{ These routines are for internal use ONLY. In no way you should try to
mess around with it, if you'd like to keep your programs being capable
of getting compiled with further improved versions of this unit. }
DisplayAtProc = Procedure(x,y:word;at:byte;s:string);
var
VideoRAM : word; { start address of video ram }
VideoPageSize : word absolute $40:$4C;{ the size of an video page }
CurrentVideoMode : Byte Absolute $40:$49;{ the mode currently in use }
StartVideoPage, { the page upon start }
StartVideoMode, { the mode upon start }
VisualVideoPage, { the page 'really' in foreground }
ActiveVideoPage, { used to store page to write on }
MaxX, MaxY,
{ Don't yet rely on that on, it might perish in future releases as well. }
LastVideoMode : byte;
{ These routines are for internal use ONLY. In no way you should try to
mess around with it, if you'd like to keep your programs being capable
of getting compiled with further improved versions of this unit. }
OptDisplayAt : DisplayAtProc; {OptDisplay : DisplayProc;}
procedure InitFCRT; { !!! Call prior to any other functions !!! }
procedure ReInitFCRT;
procedure DisablePageFlipping;
procedure EnablePageFlipping;
procedure EnableLightBackground (b:boolean);
procedure SetBlinkBit (b:boolean);
procedure ScrOn;
procedure ScrOff;
function GetVideoDisplayCode: Byte;
function GetCardStr: NameStr;
function VGACard: boolean;
function EGAAvail: boolean;
function VGAAvail: boolean;
function VGAMode: boolean;
function EGAMode: boolean;
function GetVideoMode: word;
procedure SetVideoMode(mode: word);
procedure SetActiveVideoPage(page: byte);
procedure SetVisualVideoPage(page: byte);
function GetX: byte;
function GetY: byte;
procedure SetScreenPos(x,y:byte);
procedure PutCharAttr(cha:char;attr:byte;nr:Word);
procedure CRLF;
procedure Display(at:byte;s:string);
procedure DisplayLn(at:byte;s:string);
procedure DisplayAt(x,y:word;at:byte;s:string);
(*{$F+}*)
{ These routines are basically for the units internal use and will
possibly be changed. So don't use'em directly by now, or extract'em
to a personal unit of yours. There is no guarantee yet that they will
be included in future releases also. }
procedure StdDisplay(at:byte;s:string);
procedure StdDisplayAt(x,y:word;at:byte;s:string);
procedure QuickDisplay(at:byte;s:string);
procedure QuickDisplayAt(x,y:word;at:byte;s:string);
procedure FastDisplayAt(x,y:word;at:byte;s:string);
(*{$F-}*)
procedure CursorRight(m:byte);
procedure CursorLeft(m:byte);
procedure CursorUp(m:byte);
procedure CursorDown(m:byte);
procedure SaveCursorShape(VAR CurShape:CursorShape);
procedure RestoreCursorShape(CurShape:CursorShape);
procedure SetCursorShape (FirstLine, LastLine : byte);
procedure HideCursor;
procedure NormCursor;
procedure BoxCursor;
procedure MinCursor;
procedure ColourBox (x,y,xx,yy,at:byte);
procedure ColourColumn (x,y,yy,at:byte);
procedure ColourRow (x,y,xx,at:byte);
procedure ClearBox (x,y,xx,yy,at:byte);
procedure Delay(ms : Word);
{ window related operations }
procedure ClrScr;
procedure GotoXY(x,y:Byte);
function WhereX:Byte;
function WhereY:Byte;
procedure Window(x,y,xx,yy:Byte);
procedure ClrEoL;
procedure AssignFCRT (var F : Text);
{ AssignFCRT() works similar to AssignCRT to return to FCRT
output after having its output reassigned }
{ non-window related operations to address the screen
absolutely }
procedure ClrScrAbsolute;
procedure GotoXYAbsolute(x,y:Byte);
function WhereXAbsolute:Byte;
function WhereYAbsolute:Byte;
{ don't use yourself the following routines by now, they
still need to be significantly modified }
procedure PushWindow;
procedure PopWindow;
procedure ClrEoS;
{ clear to end of screen }
Implementation
var
ch : char;
w,CRTC : word;
i : integer;
{$I FCONDRV.INC}
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ SetCursorShape (FirstLine , LastLine : byte) │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure SetCursorShape (FirstLine , LastLine : byte); assembler;
{ Original author: Orazio Czerwenka }
ASM
MOV CH,FirstLine { set top scan line }
MOV CL,LastLine { set bottom scan line }
MOV AH,01h { set text mode cursor shape }
INT 10h { call int 10h }
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ HideCursor │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure HideCursor; { tested for VGA }
{ Original author: Orazio Czerwenka }
begin
SetCursorShape($FF,$FF); { top & bottom to line 256 }
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ NormCursor │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure NormCursor; { tested for VGA }
{ Original author: Orazio Czerwenka }
begin
SetCursorShape($06,$07);
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ BoxCursor │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure BoxCursor; { tested for VGA }
{ Original author: Orazio Czerwenka }
begin
SetCursorShape($01,$07);
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ MinCursor │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure MinCursor; { tested for VGA }
{ Original author: Orazio Czerwenka }
begin
SetCursorShape($07,$07);
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ SaveCursorShape (var CurShape : CursorShape) │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure SaveCursorShape (var CurShape:CursorShape);
{ Original author: Orazio Czerwenka }
var
regs : Registers;
begin
Regs.AH:= $03; { get cursor size }
Regs.BH:= ActiveVideoPage; { page number }
INTR($10,regs); { call int 10h }
with regs do begin
CurShape.top:=CH; { save top scan line }
CurShape.bottom:=CL; { save bottom scan line }
end;
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ RestoreCursorShape (CurShape : CursorShape) │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure RestoreCursorShape (CurShape:CursorShape);
{ Original author: Orazio Czerwenka }
var
regs : Registers;
begin
with regs do
begin
AH:= $01; { set text mode cursor shape }
CH:= CurShape.top; { restore top scan line }
CL:= CurShape.bottom; { restore bottom scan line }
INTR($10,regs); { call int 10h }
end;
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ CursorRight (m : Byte) │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure CursorRight(m:byte); assembler;
{ Original author: Orazio Czerwenka }
asm
mov ah, 03h { get cursor position }
mov bh, ActiveVideoPage { page number }
int 10h
mov ah, 02h { set cursor position }
mov bh, ActiveVideoPage { page number }
mov al, m
add al, dl
mov dl, al
int 10h
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ CursorLeft (m : Byte) │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure CursorLeft(m:byte); assembler;
{ Original author: Orazio Czerwenka }
asm
mov ah, 03h { get cursor position }
mov bh, ActiveVideoPage { page number }
int 10h
mov cl, dl
mov ah, 02h { set cursor position }
mov bh, ActiveVideoPage { page number }
mov al, m
sub al, cl
mov dl, al
int 10h
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ CursorUp (m : Byte) │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure CursorUp(m:byte); assembler;
{ Original author: Orazio Czerwenka }
asm
mov ah, 03h { get cursor position }
mov bh, ActiveVideoPage { page number }
int 10h
mov cl, dh
mov ah, 02h { set cursor position }
mov bh, ActiveVideoPage { page number }
mov al, m
sub al, cl
mov dh, al
int 10h
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ CursorDown (m : Byte) │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure CursorDown(m:byte); assembler;
{ Original author: Orazio Czerwenka }
asm
mov ah, 03h { get cursor position }
mov bh, ActiveVideoPage { page number }
int 10h
mov cl, dh
mov ah, 02h { set cursor position }
mov bh, ActiveVideoPage { page number }
mov al, m
add al, cl
mov dh, al
int 10h
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ SetScreenPos ( x,y : Byte ) │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure SetScreenPos (x,y:byte); assembler;
{ Original author: Orazio Czerwenka }
ASM
MOV AH, 02h { set cursor position }
MOV BH, ActiveVideoPage { page number }
MOV DL, x { column }
MOV DH, y { row }
SUB DX, 0101h { dec DH,DL }
INT 10h { call int 10h }
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ PutCharAttr (cha : char; attr : byte; nr : Word) │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure PutCharAttr(cha:char;attr:byte;nr:Word); assembler;
{ Original author: Orazio Czerwenka }
asm
mov ah,09h { write character and attribute }
mov al,cha { character }
mov bh,ActiveVideoPage { page number }
mov bl,attr { attribute }
mov cx,nr { number of times to write }
int 10h { call int 10h }
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ ColourBox (x,y,xx,yy,at : Byte) │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure ColourBox (x,y,xx,yy,at:byte);
{ Original author: Orazio Czerwenka }
var
b1,
b2 : byte;
regs : registers;
ch : char;
begin
for b1:= x to xx do begin
for b2:= y to yy do begin
SetScreenPos(b1,b2);
with regs do begin
ah:= $08; { read character and attribute }
bh:= ActiveVideoPage; { page number }
intr($10,regs); { call int 10h }
ch:= al; { save character }
PutCharAttr(chr(ord(ch)),at,1);
end;
end;
end;
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ ColourColumn (x,y,yy,at : Byte) │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure ColourColumn (x,y,yy,at:byte);
{ Original author: Orazio Czerwenka }
var
b : byte;
ch : char;
regs : registers;
begin
for b:= y to yy do begin
SetScreenPos(x,b);
With regs do begin
ah:= $08; { read character and attribute }
bh:= ActiveVideoPage; { page number }
intr($10,regs); { call int 10h }
ch:= al; { save character }
PutCharAttr(chr(ord(ch)),at,1); { change colour attribute }
end;
end;
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ ColourRow (x,y,xx,at : Byte) │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure ColourRow (x,y,xx,at:byte);
{ Original author: Orazio Czerwenka }
var
b : byte;
ch : char;
regs : registers;
begin
for b:= x to xx do begin
SetScreenPos(b,y);
with regs do begin
ah:= $08; { read character and attribute }
bh:= ActiveVideoPage; { page number }
intr($10,regs); { call int 10h }
ch:= al; { save character }
PutCharAttr(chr(ord(ch)),at,1); { change colour attribute }
end;
end;
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ ClearBox (x,y,xx,yy,at : Byte) │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure ClearBox (x,y,xx,yy,at:byte);
{ Original author: Orazio Czerwenka }
var
aa,ax,ay,axx,ayy{,
b2} : byte;
begin
aa := TextAttr;
ax := Succ(Lo(WindMin));
ay := Succ(Hi(WindMin));
axx := Succ(Lo(WindMax));
ayy := Succ(Hi(WindMax));
window(x,y,xx,yy);
textattr:= at;
ClrScr;
window(ax,ay,axx,ayy);
textattr:= aa;
{
for b2:= y to yy do begin
SetScreenPos(x,b2);
PutCharAttr(chr($20),at,xx-x+1);
end;
}
end;
{ ************************************************************************** }
procedure StdDisplayAt(x,y:word;at:byte;s:string);
{ Original author: Orazio Czerwenka }
var
i : byte;
begin
for i:= 1 to length(s) do begin
SetScreenPos(x,y);
PutCharAttr(s[i],at,1);
inc(x);
end;
end;
{ ************************************************************************** }
procedure QuickDisplayAt(x,y:word;at:byte;s:string);
{ Original author: Sean Palmer
modifications Orazio Czerwenka }
var
vidPtr : ^word;
cnter,
attrib : word;
begin
attrib := swap(at);
CASE ActiveVideoPage OF
0: vidptr := ptr(VideoRAM,
(MaxX * pred(Y) + pred(X)) SHL 1);
1: vidptr := ptr(VideoRAM, VideoPageSize
+ (MaxX * pred(Y) + pred(X)) SHL 1
);
2: vidptr := ptr(VideoRAM, VideoPageSize SHL 1
+ (MaxX * pred(Y) + pred(X)) SHL 1
);
4: vidptr := ptr(VideoRAM, VideoPageSize SHL 2
+ (MaxX * pred(Y) + pred(X)) SHL 1
);
else vidptr := ptr(VideoRAM, VideoPageSize*ActiveVideoPage
+ (MaxX * pred(Y) + pred(X)) SHL 1
);
end;
for cnter := 1 to length(s) do
begin
vidptr^ := attrib or byte (s[cnter]);
inc(vidptr);
end;
end;
{ ************************************************************************** }
procedure FastDisplayAt(x,y:word;at:byte;s:string); assembler;
{ Original author: Jens Larsson }
asm
dec x
dec y
mov ax,y
mov cl,5
shl ax,cl
mov di,ax
mov cl,2
shl ax,cl
add di,ax
shl x,1
add di,x
mov ax,VideoRAM {0b800h} { 0b000h for mono }
mov es,ax
xor ch,ch
push ds
lds si,s
lodsb
mov cl,al
mov ah,at
jcxz @@End
@@L1:
lodsb
stosw
loop @@L1
@@End:
pop ds
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ DisplayAt (x,y : Word; at : Byte; s : string) │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure DisplayAt(x,y:word;at:byte;s:string);
{ Original author: Orazio Czerwenka }
begin
OptDisplayAt(x,y,at,s);
{ SetScreenPos(x+ord(s[0]),y);}
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ GetVideoDisplayCode : Byte │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
function GetVideoDisplayCode: Byte;
{ Original author: Orazio Czerwenka }
begin
asm
mov ax, 1A00h { read video-display combination code }
int 10h
cmp al, 1Ah { ps/2 compatible ? }
je @OK
xor cl, cl { to evaluate unsupported or unknown }
mov @result, cl
jmp @END
@OK:
mov @result, bl
@END:
end;
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ GetCardStr : NameStr │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
function GetCardStr: NameStr;
{ Original author: Orazio Czerwenka }
begin
case GetVideoDisplayCode of
$00: GetCardStr:= 'none'; { no graphics adapter }
$01: GetCardStr:= 'mda'; { monochrome display adapter (= hgc ?) }
$02: GetCardStr:= 'cga_c'; { _c w/ colour, _m w/ monochrome display }
$04: GetCardStr:= 'ega_c';
$05: GetCardStr:= 'ega_m';
$06: GetCardStr:= 'pga_c';
$07: GetCardStr:= 'vga_m_a'; { _a w/ analag, _d w/ digital display }
$08: GetCardStr:= 'vga_c_a';
$0a: GetCardStr:= 'mcga_c_d';
$0b: GetCardStr:= 'mcga_m_a';
$0c: GetCardStr:= 'mcga_c_a';
$ff: GetCardStr:= 'unknown';
end;
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ VGACard : Boolean │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
function VGACard: boolean; { returns true even if in ega mode }
{ Original author: Orazio Czerwenka }
var { should work on none ps/2 as well }
regs : registers; { for it directly goes the vgabios }
begin
regs.ah:= $12; { alternate function select }
regs.bl:= $34; { cursor emulation, vga bios only }
regs.al:= $00; { enable cursor emulation }
intr($10,regs);
VGACard:= regs.al = $12; { al = $12 if function supported }
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ EGAAvail : Boolean │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
Function EGAAvail : Boolean; Assembler; { true for ega AND higher }
{ Original author: Orazio Czerwenka
modifications according to Max Maischein }
Asm
push bp
mov ax, 1130h
xor bh, bh
int 10h
mov al, 0
cmc
adc al, al
pop bp
End;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ VGAAvail : Boolean │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
Function VGAAvail : Boolean;
{ Original author Orazio Czerwenka,
modifications according to Max Maischein }
Assembler;
{INT 10 - VIDEO - GET INDIVIDUAL PALETTE REGISTER (VGA)}
Asm
mov ax, 1007h
xor bx, bx
int 10h
mov al, 1
sbb al, 0
ret
End;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ VGAMode : Boolean │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
function VGAMode: boolean; { PS,VGA/MCGA }
{ Original author: Orazio Czerwenka }
var
regs : registers;
begin
regs.ah:= $1a; { video display combination }
regs.al:= $00; { read display combination code }
intr($10,regs); { do it babe, do it }
VGAMode:= (regs.al=$1a) and (regs.bl in [$07,$08])
end; { al=$1a if function supported,
bl=$07,$08 if in vga mode }
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ EGAMode : Boolean │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
function EGAMode: boolean; { PS,VGA/MCGA }
{ Original author: Orazio Czerwenka }
var
regs : registers;
begin
regs.ah:= $1a; { video display combination }
regs.al:= $00; { read display combination code }
intr($10,regs); { do it babe, do it }
EGAMode:= (regs.al=$1a) and (regs.bl in [$04,$05])
end; { al=$1a if function supported (PS,
VGA/MCGA), bl=$07,$08 if vga (or
mcga?) in egamode }
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ CRLF │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure CRLF; assembler;
{ Original author: Max Maischein }
{ modifications Orazio Czerwenka }
asm
mov al, 0Dh
int 29h
mov al, 0Ah
int 29h
end;
{ ************************************************************************** }
procedure QuickDisplay(at:byte;s:string);
{ Original author: Sean Palmer
modifications Orazio Czerwenka }
var
vidPtr : ^word;
cnter,
attrib : word;
begin
attrib := swap(at);
vidptr := ptr(VideoRAM, VideoPageSize*ActiveVideoPage
+ (MaxX * pred(GetY) + pred(GetX)) SHL 1
);
for cnter := 1 to length(s) do
begin
vidptr^ := attrib or byte(s[cnter]);
inc(vidptr);
end;
Cursorright(length(s));
end;
{ ************************************************************************** }
procedure StdDisplay(at:byte;s:string);
{ Original author: Orazio Czerwenka }
var
i : byte;
begin
for i:= 1 to length(s) do begin
if GetX > MaxX then SetScreenPos(1,GetY+1);
PutCharAttr(s[i],at,1);
CursorRight(1);
end;
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ Display (at : Byte; s : String) │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure Display(at:byte;s:string);
{ Original author: Orazio Czerwenka }
begin
{
quickDisplay(at,s);
}
textattr:= at;
write(s);
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ DisplayLn (at : Byte; s : String) │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure DisplayLn(at:byte;s:string);
{ Original author: Orazio Czerwenka }
begin
Display(at,s);
CRLF;
end;
{ ************************************************************************** }
procedure SetOptimalDisplay;
{ Original author: Orazio Czerwenka }
begin
if PageFlipping then
OptDisplayAt:= QuickDisplayAt
else begin
if (MaxX = 80) and (ActiveVideoPage = 0)
then OptDisplayAt:= FastDisplayAt
else OptDisplayAt:= QuickDisplayAt;
end
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ EnablePageFlipping │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure EnablePageFlipping;
{ Original author: Orazio Czerwenka }
begin
PageFlipping:= true;
SetOptimalDisplay;
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ DisablePageFlipping │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure DisablePageFlipping;
{ Original author: Orazio Czerwenka }
begin
PageFlipping:= false;
SetOptimalDisplay;
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ GetX : Byte │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
function GetX: byte;
{ Original author: Orazio Czerwenka }
begin
GetX:= Succ(Mem[$40:$50+ActiveVideoPage shl 1]); { tested for VGA }
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ GetY : Byte │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
function GetY: byte;
{ Original author: Orazio Czerwenka }
begin
GetY := Succ(Mem[$40:$51+ActiveVideoPage shl 1]); { tested for VGA }
if (not VGAAvail) and EGAAvail
then GetY:= Mem[$40:$51+ActiveVideoPage shl 1]; { untested for EGA }
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ Delay (ms : Word) │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure Delay(ms : Word); Assembler;
{ SWAG Support Team }
Asm {machine independent Delay function}
mov ax, 1000;
mul ms;
mov cx, dx;
mov dx, ax;
mov ah, $86;
int $15;
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ GetVideoMode : Word │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
function GetVideoMode: word;
{ Original author: Orazio Czerwenka }
var
regs : registers;
begin
regs.ah:= $0F;
intr($10,regs);
GetVideoMode:= regs.al;
end;
procedure SetVideoMode(Mode:Word);
{ Original author: Orazio Czerwenka,
modified by Paul Schubert }
begin
if Mode <> CurrentVideoMode then
LastVideoMode:= CurrentVideoMode;
asm
mov ax,mode
int 10h
end;
ReInitFCRT;
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ SetActiveVideoPage (page : Byte) │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure SetActiveVideoPage(page:byte);
{ Original author: Orazio Czerwenka
modified by Paul Schubert }
begin
if PageFlipping then begin
ActiveVideoPage:= page;
windmin := wmi[page];
windmax := wma[page];
end;
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ SetVisualVideoPage (page : Byte) │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure SetVisualVideoPage(page:byte);
{ Original author: Orazio Czerwenka }
begin
if PageFlipping then begin
asm
mov AH, 05h { set active page }
mov AL, page { page number }
int 10h
end;
VisualVideoPage:= page;
Mem[$40:$62]:= VisualVideoPage;
end;
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ SetBlinkBit (b: Boolean) │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure SetBlinkBit (b:boolean); { supposed to work on HGC/EGA/VGA }
{ Posted by Christian Proehl
05/24/1994 PASCAL.GER, modifications Orazio Czerwenka }
const
HGC = 7;
var
PortAddr : word;
regs : registers;
begin
regs.AX:= $1003;
if GetVideoMode = HGC
then PortAddr:= $3B8
else PortAddr:= $3D8;
if b then begin
regs.BL:= $01;
intr($10,regs);
if regs.AL = $03 then Port[PortAddr]:= Mem[$40:$65] or $20;
end
else begin
regs.BL:= $00;
intr($10,regs);
if regs.AL = $03 then Port[PortAddr]:= Mem[$40:$65] and $DF;
end;
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ EnableLightBackground (b : Boolean) │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure EnableLightBackground (b:boolean); { supposed to work on MDA/EGA/VGA }
{ Posted by Christian Proehl
05/24/1994 PASCAL.GER, modifications Orazio Czerwenka }
const
MDA = 7;
var
PortAddr : word;
regs : registers;
begin
regs.AX:= $1003;
if GetVideoMode = MDA
then PortAddr:= $3B8
else PortAddr:= $3D8;
if b then begin
regs.BL:= $00;
intr($10,regs);
if regs.AL = $03 then Port[PortAddr]:= Mem[$40:$65] and $DF;
end
else begin
regs.BL:= $01;
intr($10,regs);
if regs.AL = $03 then Port[PortAddr]:= Mem[$40:$65] or $20;
end;
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ ScrOn │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure ScrOn;
procedure VGAScrOn; assembler;
{ Original author: Max Maischein, CRT2 }
asm
mov bl, 36h
mov ax, 1200h
int 10h
end;
begin
if VGACard then VGAScrOn;
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ ScrOff │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure ScrOff;
procedure VGAScrOff; assembler;
{ Original author: Max Maischein, CRT2 }
asm
mov bl, 36h
mov ax, 1201h
int 10h
end;
begin
if VGACard then VGAScrOff;
end;
{ ************************************************************************** }
procedure InitAtStart;
begin
StartVideoPage := Mem[$40:$62];
VisualVideoPage := StartVideoPage;
ActiveVideoPage := VisualVideoPage;
StartVideoMode := CurrentVideoMode;
LastVideoMode := StartVideoMode;
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ ReInitFCRT │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure ReInitFCrt;
{ Original author: Orazio Czerwenka }
begin
if CurrentVideoMode = 7
then VideoRAM:= $B000
else VideoRAM:= $B800;
MaxY:= Mem[$40:$84];
if VGACard then inc(MaxY);
MaxX:= Mem[$40:$4A];
SetOptimalDisplay;
REINITFCONDRV;
ASSIGNFCRT(OUTPUT);
REWRITE(OUTPUT);
end;
{ ************************************************************************** }
{ ╒════════════════════════════════════════════════════════════════════════╕ }
{ │ InitFCRT │ }
{ ╘════════════════════════════════════════════════════════════════════════╛ }
procedure InitFCRT;
begin
InitAtStart;
ReInitFCRT;
end;
{$IFOPT O-}
begin
InitFCRT;
{$ENDIF}
end.